!
! File: nfw.f90
!
! Author: Pavel Sakov, CSIRO Marine Research, NERSC
!
! Created: 17 March 2005
!
! Purpose: Contains wrappers to netcdf functions, mainly for easier
!          error handling.
! 
! Description:
!
!          Each subroutine in nfw.f90 is a simple wrapper of a similar
!          function in the NetCDF Fortran interface. The rules of use are
!          pretty simple: for a given NetCDF Fortran function, replace
!          prefix "nf_" by "nfw_" and add the NetCDF file name as the
!          first argument.
!
!          Here is the current list of subroutines in nfw_mod:
!
!          nfw_create(fname, mode, ncid)
!          nfw_open(fname, mode, ncid)
!          nfw_open2(fname, mode, ncid, status)
!          nfw_enddef(fname, ncid)
!          nfw_sync(fname, ncid)
!          nfw_close(fname, ncid)
!          nfw_inq_attid(fname, ncid, varid, attname, attnum)
!          nfw_inq_attname(fname, ncid, varid, attrid, attname)
!          nfw_inq_unlimdim(fname, ncid, unlimdimid)
!          nfw_inq_dimid(fname, ncid, name, dimid)
!          nfw_inq_dimname(fname, ncid, dimid, name)
!          nfw_inq_dimlen(fname, ncid, dimid, length)
!          nfw_def_dim(fname, ncid, name, length, dimid)
!          nfw_def_var(fname, ncid, name, type, ndims, dimids, varid)
!          nfw_inq_varid(fname, ncid, name, varid)
!          nfw_inq_varname(fname, ncid, varid, name)
!          nfw_inq_varndims(fname, ncid, varid, ndims)
!          nfw_inq_vardimid(fname, ncid, varid, dimids)
!          nfw_inq_varnatts(fname, ncid, varid, natts)
!          nfw_rename_var(fname, ncid, oldname, newname)
!          nfw_put_var_int(fname, ncid, varid, v)
!          nfw_put_var_double(fname, ncid, varid, v)
!          nfw_put_var_real(fname, ncid, varid, v)
!          nfw_get_var_text(fname, ncid, varid, v)
!          nfw_get_var_int(fname, ncid, varid, v)
!          nfw_get_var_double(fname, ncid, varid, v)
!          nfw_get_var_real(fname, ncid, varid, v)
!          nfw_put_vara_int(fname, ncid, varid, start, length, v)
!          nfw_put_vara_double(fname, ncid, varid, start, length, v)
!          nfw_put_vara_real(fname, ncid, varid, start, length, v)
!          nfw_get_vara_int(fname, ncid, varid, start, length, v)
!          nfw_get_vara_double(fname, ncid, varid, start, length, v)
!          nfw_get_vara_real(fname, ncid, varid, start, length, v)
!          nfw_get_att_int(fname, ncid, varid, attname, v)
!          nfw_get_att_real(fname, ncid, varid, attname, v)
!          nfw_get_att_double(fname, ncid, varid, attname, v)
!          nfw_put_att_text(fname, ncid, varid, attname, length, text)
!          nfw_put_att_int(fname, ncid, varid, attname, type, length, v)
!          nfw_put_att_real(fname, ncid, varid, attname, type, length, v)
!          nfw_put_att_double(fname, ncid, varid, attname, type, length, v)
!          nfw_copy_atts(fname_src, ncid_src, varid_src,&
!                        fname_dst, ncid_dst, varid_dst)
!
!          Derived procedures:
!
!          nfw_get_var_double_record(fname, ncid, varid, r, v)
!          nfw_get_var_int_record(fname, ncid, varid, r, v)
!          nfw_var_exists(ncid, name)
!          nfw_dim_exists(ncid, name)
!          nfw_att_exists(ncid, varid, attname)
! Modifications:
!
! 29/04/2008 PS: added nfw_rename_var(fname, ncid, oldname, newname)
! 21/10/2009 PS: added nfw_var_exists(ncid, name)
! 22/10/2009 PS: added nfw_put_att_double(fname, ncid, varid, attname, type, 
!                                         length, v)
! 06/11/2009 PS: added nfw_dim_exists(ncid, name)
!                nfw_put_att_real(fname, ncid, varid, attname, type, length, v)
!                nfw_get_att_real(fname, ncid, varid, attname, v)
! 14/12/2011 PS: added nfw_open2(fname, mode, ncid, status)
!                nfw_get_var_text(fname, ncid, varid, v)
!                nfw_get_var_real(fname, ncid, varid, v)
!                nfw_put_vara_real(fname, ncid, varid, start, length, v)
!                nfw_get_vara_real(fname, ncid, varid, start, length, v)
! 30/03/2012 PS: added nfw_inq_attid(fname, ncid, varid, attname, attnum)
!                nfw_inq_attname(fname, ncid, varid, attrid, attname)
!                nfw_inq_dimname(fname, ncid, dimid, name)
!                nfw_inq_varnatts(fname, ncid, varid, natts)
!                nfw_copy_atts(fname_src, ncid_src, varid_src,&
!                              fname_dst, ncid_dst, varid_dst)
! 13/04/2012 PS: replaced nfw_get_var_double_firstrecord(fname, ncid, varid, v)
!                  by nfw_get_var_record(fname, ncid, varid, r, v)
!                added nfw_get_var_int_record(fname, ncid, varid, r, v)
!                a record is now defined as a slab that has length of 1 for
!                the most outer dimension (irrespective of whether it is a
!                record dimension or not)

module nfw_mod
  implicit none
  include 'netcdf.inc'

  character(*), private, parameter :: nfw_version = "0.07"
  integer, private, parameter :: logunit = 6
  character(*), private, parameter :: errprefix = "nfw: error: "
  private quit1, quit2, quit3

contains

#if defined(F90_NOFLUSH)
  subroutine flush(dummy)
    integer, intent(in) :: dummy
  end subroutine flush
#endif

  ! Common exit point -- for the sake of debugging
  subroutine quit
    stop
  end subroutine quit

  subroutine quit1(fname, procname, status)
    character*(*), intent(in) :: fname
    character*(*), intent(in) :: procname
    integer, intent(in) :: status
 
    write(logunit, *)
    write(logunit, *) errprefix, '"', trim(fname), '": ', procname, '(): ',&
         nf_strerror(status)
    call flush(logunit)
    call quit
  end subroutine quit1

  subroutine quit2(fname, procname, name, status)
    character*(*), intent(in) :: fname
    character*(*), intent(in) :: procname
    character*(*), intent(in) :: name
    integer, intent(in) :: status

    write(logunit, *)
    write(logunit, *) errprefix, '"', trim(fname), '": ', procname, '(): "',&
         trim(name), '": ', nf_strerror(status)
    call flush(logunit)
    call quit
  end subroutine quit2

  subroutine quit3(fname, procname, name1, name2, status)
    character*(*), intent(in) :: fname
    character*(*), intent(in) :: procname
    character*(*), intent(in) :: name1
    character*(*), intent(in) :: name2
    integer, intent(in) :: status

    write(logunit, *)
    write(logunit, *) errprefix, '"', trim(fname), '": ', procname, '(): "',&
         trim(name1), '": "', trim(name2), '": ', nf_strerror(status)
    call flush(logunit)
    call quit
  end subroutine quit3

  subroutine nfw_create(fname, mode, ncid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: mode
    integer, intent(out) :: ncid

    integer :: status

    status = nf_create(trim(fname), mode, ncid)
    if (status /= 0) call quit1(fname, 'nf_create', status)
  end subroutine nfw_create

  subroutine nfw_open(fname, mode, ncid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: mode
    integer, intent(out) :: ncid

    integer :: status

    status = nf_open(trim(fname), mode, ncid)
    if (status /= 0) call quit1(fname, 'nf_open', status)
  end subroutine nfw_open

  subroutine nfw_open2(fname, mode, ncid, status)
    character*(*), intent(in) :: fname
    integer, intent(in) :: mode
    integer, intent(out) :: ncid
    integer, intent(out) :: status

    status = nf_open(trim(fname), mode, ncid)
  end subroutine nfw_open2

  subroutine nfw_enddef(fname, ncid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid

    integer :: status

    status = nf_enddef(ncid)
    if (status /= 0) call quit1(fname, 'nf_enddef', status)
  end subroutine nfw_enddef

  subroutine nfw_sync(fname, ncid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid

    integer :: status

    status = nf_enddef(ncid)
    status = nf_sync(ncid)
    if (status /= 0) call quit1(fname, 'nf_sync', status)
  end subroutine nfw_sync

  subroutine nfw_redef(fname, ncid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid

    integer :: status

    status = nf_redef(ncid)
    if (status /= 0) call quit1(fname, 'nf_redef', status)
  end subroutine nfw_redef

  subroutine nfw_close(fname, ncid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid

    integer :: status

    status = nf_close(ncid)
    if (status /= 0) call quit1(fname, 'nf_close', status)
  end subroutine nfw_close

  subroutine nfw_inq_attid(fname, ncid, varid, attname, attnum)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname
    integer, intent(out) :: attnum

    integer :: status
    character*(NF_MAX_NAME) :: varname

    status = nf_inq_attid(ncid, varid, attname, attnum)
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_inq_attnum', varname, attname, status)
    end if
  end subroutine nfw_inq_attid

  subroutine nfw_inq_attname(fname, ncid, varid, attnum, attname)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: attnum
    character*(*), intent(out) :: attname

    integer :: status
    character*(NF_MAX_NAME) :: varname

    status = nf_inq_attname(ncid, varid, attnum, attname)
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_inq_attname', varname, attname, status)
    end if
  end subroutine nfw_inq_attname

  subroutine nfw_inq_unlimdim(fname, ncid, unlimdimid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(out) :: unlimdimid

    integer :: status
    
    status = nf_inq_unlimdim(ncid, unlimdimid)
    if (status /= 0) call quit1(fname, 'nf_inq_unlimdimid', status)
  end subroutine nfw_inq_unlimdim

  subroutine nfw_inq_dimid(fname, ncid, name, dimid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    character*(*), intent(in) :: name
    integer, intent(out) :: dimid

    integer :: status
    
    status = nf_inq_dimid(ncid, trim(name), dimid)
    if (status /= 0) call quit2(fname, 'nf_inq_dimid', name, status)
  end subroutine nfw_inq_dimid

  subroutine nfw_inq_dimname(fname, ncid, dimid, name)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: dimid
    character*(*), intent(out) :: name

    integer :: status

    status = nf_inq_dimname(ncid, dimid, name)
    if (status /= 0) call quit1(fname, 'nf_inq_dimname', status)
  end subroutine nfw_inq_dimname

  subroutine nfw_inq_dimlen(fname, ncid, dimid, length)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: dimid
    integer, intent(out) :: length

    integer :: status

    status = nf_inq_dimlen(ncid, dimid, length)
    if (status /= 0) call quit1(fname, 'nf_inq_dimlen', status)
  end subroutine nfw_inq_dimlen

  subroutine nfw_def_dim(fname, ncid, name, length, dimid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    character*(*), intent(in) :: name
    integer, intent(in) :: length
    integer, intent(out) :: dimid

    integer :: status

    status = nf_def_dim(ncid, name, length, dimid)
    if (status /= 0) call quit2(fname, 'nf_def_dim', name, status)
  end subroutine nfw_def_dim

  subroutine nfw_def_var(fname, ncid, name, type, ndims, dimids, varid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    character*(*), intent(in) :: name
    integer, intent(in) :: type
    integer, intent(in) :: ndims
    integer, intent(in) :: dimids(*)
    integer, intent(out) :: varid

    integer :: status

    status = nf_def_var(ncid, name, type, ndims, dimids, varid)
    if (status /= 0) call quit2(fname, 'nf_def_var', name, status)
  end subroutine nfw_def_var

  subroutine nfw_inq_varid(fname, ncid, name, varid)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    character*(*), intent(in) :: name
    integer, intent(out) :: varid

    integer :: status
   
    status = nf_inq_varid(ncid, trim(name), varid)
    if (status /= 0) call quit2(fname, 'nf_inq_varid', name, status)
  end subroutine nfw_inq_varid

  subroutine nfw_inq_varname(fname, ncid, varid, name)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(out) :: name

    integer :: status

    status = nf_inq_varname(ncid, varid, name)
    if (status /= 0) call quit1(fname, 'nf_inq_varname', status)
  end subroutine nfw_inq_varname

  subroutine nfw_inq_varndims(fname, ncid, varid, ndims)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(out) :: ndims

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_inq_varndims(ncid, varid, ndims)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_inq_varndims', name, status)
    end if
  end subroutine nfw_inq_varndims

  subroutine nfw_inq_vardimid(fname, ncid, varid, dimids)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(out) :: dimids(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_inq_vardimid(ncid, varid, dimids)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_inq_vardimid', name, status)
    end if
  end subroutine nfw_inq_vardimid

  subroutine nfw_inq_varnatts(fname, ncid, varid, natts)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(out) :: natts

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_inq_varnatts(ncid, varid, natts)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_inq_varnatts', name, status)
    end if
  end subroutine nfw_inq_varnatts

  subroutine nfw_rename_var(fname, ncid, oldname, newname)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    character*(*), intent(in) :: oldname
    character*(*), intent(in) :: newname

    integer :: varid
    integer :: status

    call nfw_inq_varid(fname, ncid, oldname, varid)
    status = nf_rename_var(ncid, varid, newname)
    if (status /= 0) then
       call quit2(fname, 'nf_rename_var', oldname, status)
    end if
  end subroutine nfw_rename_var

  subroutine nfw_put_var_int(fname, ncid, varid, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_put_var_int(ncid, varid, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_put_var_double', name, status)
    end if
  end subroutine nfw_put_var_int

  subroutine nfw_put_var_double(fname, ncid, varid, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    real(8), intent(in) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_put_var_double(ncid, varid, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_put_var_double', name, status)
    end if
  end subroutine nfw_put_var_double

  subroutine nfw_put_var_real(fname, ncid, varid, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    real(4), intent(in) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_put_var_real(ncid, varid, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_put_var_real', name, status)
    end if
  end subroutine nfw_put_var_real

  subroutine nfw_get_var_text(fname, ncid, varid, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character, intent(out) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_get_var_text(ncid, varid, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_get_var_int', name, status)
    end if
  end subroutine nfw_get_var_text

  subroutine nfw_get_var_int(fname, ncid, varid, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(out) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_get_var_int(ncid, varid, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_get_var_int', name, status)
    end if
  end subroutine nfw_get_var_int

  subroutine nfw_get_var_double(fname, ncid, varid, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    real(8), intent(out) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_get_var_double(ncid, varid, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_get_var_double', name, status)
    end if
  end subroutine nfw_get_var_double

  subroutine nfw_get_var_real(fname, ncid, varid, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    real(4), intent(out) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_get_var_real(ncid, varid, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_get_var_real', name, status)
    end if
  end subroutine nfw_get_var_real

  subroutine nfw_put_vara_int(fname, ncid, varid, start, length, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: start(*)
    integer, intent(in) :: length(*)
    integer, intent(in) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_put_vara_int(ncid, varid, start, length, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_put_vara_int', name, status)
    end if
  end subroutine nfw_put_vara_int

  subroutine nfw_put_vara_double(fname, ncid, varid, start, length, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: start(*)
    integer, intent(in) :: length(*)
    real(8), intent(in) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_put_vara_double(ncid, varid, start, length, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_put_vara_double', name, status)
    end if
  end subroutine nfw_put_vara_double

  subroutine nfw_put_vara_real(fname, ncid, varid, start, length, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: start(*)
    integer, intent(in) :: length(*)
    real(4), intent(in) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_put_vara_real(ncid, varid, start, length, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_put_vara_real', name, status)
    end if
  end subroutine nfw_put_vara_real

  subroutine nfw_get_vara_int(fname, ncid, varid, start, length, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: start(*)
    integer, intent(in) :: length(*)
    integer, intent(out) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_get_vara_int(ncid, varid, start, length, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_get_vara_int', name, status)
    end if
  end subroutine nfw_get_vara_int

  subroutine nfw_get_vara_double(fname, ncid, varid, start, length, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: start(*)
    integer, intent(in) :: length(*)
    real(8), intent(out) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_get_vara_double(ncid, varid, start, length, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_get_vara_double', name, status)
    end if
  end subroutine nfw_get_vara_double

  subroutine nfw_get_vara_real(fname, ncid, varid, start, length, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: start(*)
    integer, intent(in) :: length(*)
    real(4), intent(out) :: v(*)

    character*(NF_MAX_NAME) :: name
    integer :: status

    status = nf_get_vara_real(ncid, varid, start, length, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_get_vara_real', name, status)
    end if
  end subroutine nfw_get_vara_real

  subroutine nfw_get_att_text(fname, ncid, varid, attname, text)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname
    character*(*), intent(out) :: text

    integer :: status
    character*(NF_MAX_NAME) :: varname

    status = nf_get_att_text(ncid, varid, attname, text)
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_get_att_text', varname, attname, status)
    end if

  end subroutine nfw_get_att_text

  subroutine nfw_get_att_int(fname, ncid, varid, attname, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname
    integer, intent(out) :: v(*)

    character*(NF_MAX_NAME) :: varname
    integer :: status

    status = nf_get_att_int(ncid, varid, attname, v)
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_get_att_int', varname, attname, status)
    end if
  end subroutine nfw_get_att_int

  subroutine nfw_get_att_real(fname, ncid, varid, attname, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname
    real(4), intent(out) :: v(*)

    character*(NF_MAX_NAME) :: varname
    integer :: status

    status = nf_get_att_real(ncid, varid, attname, v)
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_get_att_real', varname, attname, status)
    end if
  end subroutine nfw_get_att_real

  subroutine nfw_get_att_double(fname, ncid, varid, attname, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname
    real(8), intent(out) :: v(*)

    character*(NF_MAX_NAME) :: varname
    integer :: status

    status = nf_get_att_double(ncid, varid, attname, v)
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_get_att_double', varname, attname, status)
    end if
  end subroutine nfw_get_att_double

  subroutine nfw_put_att_text(fname, ncid, varid, attname, length, text)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname
    integer, intent(in) :: length
    character*(*), intent(in) :: text

    integer :: status
    character*(NF_MAX_NAME) :: varname

    status = nf_put_att_text(ncid, varid, attname, length, trim(text))
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_put_att_text', varname, attname, status)
    end if
  end subroutine nfw_put_att_text

  subroutine nfw_put_att_int(fname, ncid, varid, attname, type, length, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname
    integer, intent(in) :: type
    integer, intent(in) :: length
    integer, intent(in) :: v(*)

    integer :: status
    character*(NF_MAX_NAME) :: varname

    status = nf_put_att_int(ncid, varid, attname, type, length, v)
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_put_att_int', varname, attname, status)
    end if
  end subroutine nfw_put_att_int

  subroutine nfw_put_att_real(fname, ncid, varid, attname, type, length, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname
    integer, intent(in) :: type
    integer, intent(in) :: length
    real(4), intent(in) :: v(*)

    integer :: status
    character*(NF_MAX_NAME) :: varname

    status = nf_put_att_real(ncid, varid, attname, type, length, v)
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_put_att_real', varname, attname, status)
    end if
  end subroutine nfw_put_att_real

  subroutine nfw_put_att_double(fname, ncid, varid, attname, type, length, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname
    integer, intent(in) :: type
    integer, intent(in) :: length
    real(8), intent(in) :: v(*)

    integer :: status
    character*(NF_MAX_NAME) :: varname

    status = nf_put_att_double(ncid, varid, attname, type, length, v)
    if (status /= 0) then
       if (varid /= nf_global) then
          call nfw_inq_varname(fname, ncid, varid, varname)
       else
          varname = 'NF_GLOBAL'
       end if
       call quit3(fname, 'nf_put_att_double', varname, attname, status)
    end if
  end subroutine nfw_put_att_double

! Derived subroutines

  ! Reads one record only
  subroutine nfw_get_var_double_record(fname, ncid, varid, r, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: r
    real(8), intent(out) :: v(*)

    integer :: ndims
    integer :: dimids(NF_MAX_VAR_DIMS)
    integer :: dimlen(NF_MAX_VAR_DIMS)
    integer :: dstart(NF_MAX_VAR_DIMS)
    integer :: i
    character*(NF_MAX_NAME) :: name
    integer :: status

    call nfw_inq_varndims(fname, ncid, varid, ndims)
    call nfw_inq_vardimid(fname, ncid, varid, dimids)
    
    do i = 1, ndims - 1
       call nfw_inq_dimlen(fname, ncid, dimids(i), dimlen(i))
       dstart(i) = 1
    end do
    dstart(ndims) = r
    dimlen(ndims) = 1 ! 1 record only

    status = nf_get_vara_double(ncid, varid, dstart, dimlen, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_get_vara_double', name, status)
    end if
  end subroutine nfw_get_var_double_record

  subroutine nfw_get_var_int_record(fname, ncid, varid, r, v)
    character*(*), intent(in) :: fname
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    integer, intent(in) :: r
    integer, intent(out) :: v(*)

    integer :: ndims
    integer :: dimids(NF_MAX_VAR_DIMS)
    integer :: dimlen(NF_MAX_VAR_DIMS)
    integer :: dstart(NF_MAX_VAR_DIMS)
    integer :: i
    character*(NF_MAX_NAME) :: name
    integer :: status

    call nfw_inq_varndims(fname, ncid, varid, ndims)
    call nfw_inq_vardimid(fname, ncid, varid, dimids)
    
    do i = 1, ndims - 1
       call nfw_inq_dimlen(fname, ncid, dimids(i), dimlen(i))
       dstart(i) = 1
    end do
    dstart(ndims) = r
    dimlen(ndims) = 1 ! 1 record only

    status = nf_get_vara_int(ncid, varid, dstart, dimlen, v)
    if (status /= 0) then
       call nfw_inq_varname(fname, ncid, varid, name)
       call quit2(fname, 'nf_get_vara_int', name, status)
    end if
  end subroutine nfw_get_var_int_record

  logical function nfw_var_exists(ncid, name)
    integer, intent(in) :: ncid
    character*(*), intent(in) :: name

    integer :: varid
    integer :: status

    status = nf_inq_varid(ncid, trim(name), varid)
    nfw_var_exists = (status == 0)
  end function nfw_var_exists

  logical function nfw_dim_exists(ncid, name)
    integer, intent(in) :: ncid
    character*(*), intent(in) :: name

    integer :: dimid
    integer :: status

    status = nf_inq_dimid(ncid, trim(name), dimid)
    nfw_dim_exists = (status == 0)
  end function nfw_dim_exists

  logical function nfw_att_exists(ncid, varid, attname)
    integer, intent(in) :: ncid
    integer, intent(in) :: varid
    character*(*), intent(in) :: attname

    integer :: attnum
    integer :: status

    status = nf_inq_attid(ncid, varid, attname, attnum)
    nfw_att_exists = (status == 0)
  end function nfw_att_exists

  subroutine nfw_copy_atts(fname_src, ncid_src, varid_src,&
       fname_dst, ncid_dst, varid_dst)
    character*(*), intent(in) :: fname_src
    integer, intent(in) :: ncid_src
    integer, intent(in) :: varid_src
    character*(*), intent(in) :: fname_dst
    integer, intent(in) :: ncid_dst
    integer, intent(in) :: varid_dst

    character*(NF_MAX_NAME) :: name_src, name_dst, varname, attname
    integer :: natts
    integer :: status
    integer :: i

    if (varid_src /= nf_global) then
       call nfw_inq_varname(fname_src, ncid_src, varid_src, name_src)
    else
       name_src = 'NF_GLOBAL'
    end if
    if (varid_dst /= nf_global) then
       call nfw_inq_varname(fname_dst, ncid_dst, varid_dst, name_dst)
    else
       name_dst = 'NF_GLOBAL'
    end if
    call nfw_inq_varnatts(fname_src, ncid_src, varid_src, natts)

    do i = 1, natts
       call nfw_inq_attname(fname_src, ncid_src, varid_src, i, attname)
       status = nf_copy_att(ncid_src, varid_src, attname, ncid_dst, varid_dst)
       if (status /= 0) then
          call quit3(fname_src, 'nf_copy_att', name_src, attname, status)
       end if
    end do
  end subroutine nfw_copy_atts

end module nfw_mod
